home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / p-demo1.pas < prev    next >
Pascal/Delphi Source File  |  1990-08-20  |  3KB  |  154 lines
  1. {
  2.  ******************************************************************************
  3.  * P-DEMO1 - Palette demo.                              *
  4.  *                                          *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                      *
  6.  *                                          *
  7.  * Press F1 to increase screen change speed                      *
  8.  * Press F10 to toggle between 320 and 640 graphic modes              *
  9.  * Press ESC to exit program                              *
  10.  ******************************************************************************
  11. }
  12.  
  13. PROGRAM PaletteDemo1;
  14.  
  15. USES
  16.   Crt,
  17.   Grafix;
  18.  
  19. TYPE
  20.   PaletteArray = ARRAY[0..15] OF WORD;
  21.  
  22. VAR
  23.   Graphics, Distance, PauseVal, S, X, Y: INTEGER;
  24.   P: INTEGER;
  25.   Shape: ARRAY [0..1282] OF WORD;
  26.   EndProgram, Loop, Tandy11: BOOLEAN;
  27.  
  28. CONST
  29.    H0: PaletteArray = (00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15);
  30.    H1: PaletteArray = (09,01,03,03,01,03,03,01,03,03,09,09,08,09,00,15);
  31.    H2: PaletteArray = (12,00,00,00,15,15,15,15,15,15,04,12,12,12,00,15);
  32.    H3: PaletteArray = (10,07,07,08,07,07,08,07,07,08,10,10,10,02,14,06);
  33.    H4: PaletteArray = (11,14,14,14,14,14,14,06,06,06,11,03,11,11,04,01);
  34.  
  35. PROCEDURE ScreenSpeed;
  36.  
  37. BEGIN
  38.  
  39.   P := P - S;
  40.   IF P < 0 THEN
  41.     P := PauseVal;
  42.  
  43. END;
  44.  
  45. PROCEDURE CheckKey;
  46.  
  47. VAR
  48.   Ch: CHAR;
  49.  
  50. BEGIN
  51.  
  52.   Ch := #255;
  53.   IF KeyPressed THEN
  54.     Ch := ReadKey;
  55.   IF Ch = #27 THEN
  56.      BEGIN
  57.        Loop := False;
  58.        EndProgram := True;
  59.      END;
  60.   IF Ch = #00 THEN
  61.     BEGIN
  62.       Ch := ReadKey;
  63.       IF Ch = #59 THEN
  64.     ScreenSpeed;
  65.       IF (Ch = #68) AND (Tandy11 = True) THEN
  66.     BEGIN
  67.       IF Graphics = 320 THEN
  68.         BEGIN
  69.           Graphics := 640;
  70.           Distance := 576;
  71.           Loop := False;
  72.           HighGraphics;
  73.         END
  74.       ELSE
  75.          BEGIN
  76.            Graphics := 320;
  77.            Distance := 256;
  78.            Loop := False;
  79.            MediumGraphics;
  80.          END;
  81.     END;
  82.     END;
  83.  
  84. END;
  85.  
  86. PROCEDURE DelayLoop;
  87.  
  88. BEGIN
  89.  
  90.   Pause(P);
  91.   CheckKey;
  92.  
  93. END;
  94.  
  95. {Mainline}
  96. BEGIN
  97.  
  98.   BLoad('P-DEMO1.BIN', Shape[0]);
  99.   Graphics := 320;
  100.   Distance := 256;
  101.   PauseVal := 22;
  102.   S := 4;
  103.   EndProgram := False;
  104.   Loop := True;
  105.   GetTandy11(Tandy11);
  106.   MediumGraphics;
  107.  
  108.   WHILE EndProgram = False DO
  109.     BEGIN
  110.       X := 0;
  111.       REPEAT
  112.     Y := 4;
  113.     REPEAT
  114.       ExtPut(X, Y, Shape[0], PutXor);
  115.       Inc(Y, 64);
  116.     UNTIL Y > 132;
  117.     Inc(X, 64);
  118.       UNTIL X > Distance;
  119.       P := PauseVal;
  120.       WHILE Loop = True DO
  121.     BEGIN
  122.       IF Loop = True THEN
  123.         BEGIN
  124.           PaletteUsing(H0[0]);
  125.           DelayLoop;
  126.         END;
  127.       IF Loop = True THEN
  128.         BEGIN
  129.           PaletteUsing(H1[0]);
  130.           DelayLoop;
  131.         END;
  132.       IF Loop = True THEN
  133.         BEGIN
  134.           PaletteUsing(H2[0]);
  135.           DelayLoop;
  136.         END;
  137.       IF Loop = True THEN
  138.         BEGIN
  139.           PaletteUsing(H3[0]);
  140.           DelayLoop;
  141.         END;
  142.       IF Loop = True THEN
  143.         BEGIN
  144.           PaletteUsing(H4[0]);
  145.           DelayLoop;
  146.         END;
  147.     END;
  148.       IF EndProgram = False THEN
  149.      Loop := True;
  150.     END;
  151.   ExitGraphics;
  152.  
  153. END.
  154.